-----------------------------------------------------------------------------
--
-- Module      :  Data.Units.Instances
-- Copyright   :
-- License     :  AllRightsReserved
--
-- Maintainer  :  eduard.sergeev@gmail.com
-- Stability   :
-- Portability :
--
-- UNum and UFractional ('unitified' Num and Fractional) classes definitions
--
-----------------------------------------------------------------------------

{-# LANGUAGE MultiParamTypeClasses, ScopedTypeVariables, TypeOperators,
StandaloneDeriving, GeneralizedNewtypeDeriving,
TypeFamilies, UndecidableInstances, FlexibleInstances, ViewPatterns  #-}


module Data.Units.Instances
(

  QNum(..),
  QFractional(..),
  QReal(..),
  QIntegral(..),
  QFloating(..),

  (:::)(Q),
  quantitify,
  scalar,
  (<:),
  (>|),

  fromInteger,
  fromRational,

  even, odd,
  gcd,

) where

import qualified Prelude as P
import Prelude (Bounded, Enum, Show(..), Read(..), Double)

import GHC.Read
import Text.ParserCombinators.ReadP (string)
import Text.ParserCombinators.ReadPrec (lift)

import Data.Eq
import Data.Ord
import Data.Ix
import Data.Bits

import Data.Bool
import Data.Function
import Data.List ((++))
import Data.Functor
import Control.Applicative
import Control.Monad

import Data.TypeLevel.Class
import Data.Units.Class
import qualified Data.Units.Types as T


infixl 1 :::
newtype n ::: m = Q { extract :: n }


deriving instance (Eq n) => Eq (n ::: m)

instance (Show n, (T.ToCanonical (T.ToList m)) ~ c, Show c) => Show (n ::: m) where
    show n = show (extract n) ++ "<" ++ (if sm == "1" then "" else sm) ++ ">"
        where sm = show (typeValue::c)

instance (Read n, (T.ToCanonical (T.ToList m)) ~ c, Show c) => Read (n ::: m) where
    readPrec = parens $ do
      n <- readPrec
      us <- lift (string us)
      return $ qpure n
          where
            us = "<" ++ show (typeValue :: c) ++ ">"

deriving instance (Bounded n) => Bounded (n ::: m)
deriving instance (Enum n) => Enum (n ::: m)
deriving instance (Ord n) => Ord (n ::: m)
deriving instance (Ix n) => Ix (n ::: m)


instance QApplicative (:::) where
    qpure = Q
    Q f <***> Q n = Q (f n)


-- | Lifting of non-quantitified value into (any) quantitified one
quantitify :: (P.Num n) => n ::: T.U -> n ::: m
quantitify = qpure . toNum


-- | Lifting of non-quantitified value into scalar (dimentionless) of the same value
scalar :: (P.Num n) => n -> n ::: T.U
scalar = quantitify . qpure


-- | Conversion of dimetioness number into unitified number of 'u' unity
infixl 9 <:
(<:) :: (P.Num n, QNum q n, QApplicative q) => q n T.U -> q n u  -> q n u
c <: _ = qpure (toNum c)

-- | Restriction of 'u' to be of 'u'' unity
infixl 1 >|
(>|) :: (P.Num n, QNum q n, QApplicative q) => q n u -> q n u -> q n u 
u >| _ = u



-- * Instances for (:::) type 
   
instance (P.Num n) => QNum (:::) n where
    toNum = extract
    (+) = qlift2M (P.+)
    (-) = qlift2M (P.-)
    (*) = qlift2M (P.*)
    negate = (P.negate <*$*>)
    abs = (P.abs <*$*>)
    signum = (P.signum <*$*>)

fromInteger :: P.Num n => P.Integer -> n ::: T.U 
fromInteger = scalar . P.fromInteger

--(^) :: (QNum q n, QApplicative q) => q n u -> p -> q n (T.Power u p)
--q ^ _ = qpure $ toNum q

{-
instance (P.Num n, QNum q n, QApplicative q, Show (q n T.U), Eq (q n T.U)) => P.Num (q n T.U) where
    (+) = (+) 
    (-) = (-) 
    (*) = (*) 
    abs = abs 
    signum = signum
    fromInteger = qpure . P.fromInteger
-}

-- * QFractional instances
--type instance Divide l r = T.Divide l r 

instance (P.Fractional n) => QFractional (:::) n where
    (/) = qlift2M (P./)
    recip = (P.recip <*$*>)
    
fromRational = scalar . P.fromRational

instance (P.Fractional n, QFractional q n, QApplicative q, P.Num (q n T.U)) => P.Fractional (q n T.U) where
    (/) = (/) 
    fromRational = qpure . P.fromRational


--type instance ToRational n = P.Rational

instance (P.Real n) => QReal (:::) n where
    toRational = P.toRational . extract -- (P.toRational <*$*>) 


-- * Integral instance

instance (P.Integral n) => QIntegral (:::) n where
    quot = qlift2M P.quot 
    rem = qlift2M P.rem
    div = qlift2M P.div
    mod = qlift2M P.mod
    quotRem (Q l) (Q r) = let (rq,rr) = P.quotRem l r in (qpure rq , qpure rr) 
    divMod (Q l) (Q r) = let (d,m) = P.divMod l r in (qpure d , qpure m)
    toInteger =  P.toInteger . extract -- (P.toInteger <*$*>)
{-
instance (P.Integral n, QIntegral q n, QApplicative q, P.Real (q n T.U), Enum (q n T.U)) => P.Integral (q n T.U) where
    quot = quot 
    rem = rem
    div = div
    mod = mod
    quotRem = quotRem
    divMod = divMod
    toInteger = toInteger
-}

even, odd :: (P.Integral n) => n ::: u -> Bool
even (Q n) = P.even n
odd (Q n) = P.odd n

gcd :: (P.Integral n) => n ::: u -> n ::: u -> n ::: u
gcd = qlift2M P.gcd


{-
gcd             :: (QIntegral q n) => q n u -> q n u -> q n u
gcd (extract -> 0) (extract -> 0)         =  P.error "Prelude.gcd: gcd 0 0 is undefined"
gcd x y         =  gcd' (abs x) (abs y)
                   where gcd' a (extract -> 0)  =  a
                         gcd' a b  =  gcd' b (a `rem` b)
-}


-- * QFloating instance
--type instance Sqrt u = T.SquareRoot u
--type instance Scalar = T.U

instance (P.Floating n) => QFloating (:::) n where
    pi = qpure P.pi
    exp = (P.exp <*$*>)
    log = (P.log <*$*>)     
    sqrt = (P.sqrt <*$*>)
    (**) = qlift2M (P.**)
    logBase = qlift2M P.logBase
    sin = (P.sin <*$*>)
    cos = (P.cos <*$*>)
    tan = (P.tan <*$*>)
    asin = (P.asin <*$*>)
    acos = (P.acos <*$*>)
    atan = (P.atan <*$*>)
    sinh = (P.sinh <*$*>)
    cosh = (P.cosh <*$*>)
    tanh = (P.tanh <*$*>)
    asinh = (P.asinh <*$*>)
    acosh = (P.acosh <*$*>)
    atanh = (P.atanh <*$*>)


-- * Numberic functions

--even, odd       :: (QIntegral q n, P.Num n, Eq (q n u)) => q n u -> Bool
--even n          =  n `rem` (quantitify 2) == quantitify 0
--odd             =  not . even

--subtract :: (QNum q n) => q n ul -> a n ur -> a 
--subtract = flip (-)



qlift2M f l r = qpure f <***> l <***> r
f <*$*> q = qpure f <***> q


